Collection of Tools & Utilities/Collection of Tools and Utilities.iso/basic/vudu31q.zip/VUDEMO.BAS

BASIC Source File | 1992-06-07 | 21KB | 684 lines

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*             VUDEMO.BAS - VUDU Windows Demonstration Program               *
'*                                                                           *
'*                               Binary Systems                              *
'*                               PO BOX 10714                                *
'*                               FARGO, ND  58106                            *
'*                               [phone]                              *
'*                                                                           *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'$INCLUDE: 'VUDU.INC'

DECLARE SUB datedemo ()
DECLARE SUB overview ()
DECLARE SUB printdemo ()
DECLARE SUB randomtest ()
DECLARE SUB randscroll ()
DECLARE SUB windowdemo ()
DECLARE SUB windows ()
DECLARE SUB infielddemo ()
DECLARE SUB messagedemo ()
DECLARE SUB scrolldemo ()
DECLARE SUB bardemo ()
DECLARE SUB begin ()


DEFINT A-Z
CONST HEADLINE = "VUDU Windows Version 3.01 for QuickBASIC and PDS 7 ∙ Demo Program"
DIM SHARED background AS STRING
DIM lin(1 TO 3) AS STRING

' Attributes For Window Interactive Demo
DIM SHARED oldrow   AS INTEGER, oldcol   AS INTEGER
DIM SHARED oldwfg   AS INTEGER, oldwbg   AS INTEGER
DIM SHARED oldhedfg AS INTEGER, oldhedbg AS INTEGER
DIM SHARED oldshad  AS INTEGER, oldedge  AS INTEGER

' Type For INFIELD Specifications
TYPE fieldtype
     row AS INTEGER
     Col AS INTEGER
     lng AS INTEGER
END TYPE

'Main Proc
    VINIT   ' call VINIT before executing any VUDU statements

    ' Setting the default values for the 'stretchy box' demo
    oldrow = 22: oldcol = 76
    oldhedfg = 15: oldhedbg = 1
    oldwfg = 15: oldwbg = 1
    oldshad = NO: oldedge = 2

    FirstLet = CM(YEL + BRITE, WHT + BRITE + FLASH)
    LabelPos = RIGHT

    LOCATE , , 0                    'Cursor off
    SCREEN 0: WIDTH 80, 25          '25x80 text mode

    ' This is the whole program?
    SAVSCREEN scr$
    begin
    RESCREEN scr$

    lin(1) = "    For ordering information, type out the file 'README'"
    lin(2) = " Thank you for viewing VUDU Window Demo by Binary Systems."
    lin(3) = "              Good night and drive safely."
    DEFWIN 0, 0, 0, 3, 0, 3, THIN, YES
    a$ = MESSAGE(r, c, "", lin(), "", 10, YES)

    PRINTS SPACE$(80), 25, 1, 0
    LOCATE 25, 1, 1

END



' DATADATADATA - I Like To Keep My DATA Down Out Of The Way - DATADATADATA

menudata:
DATA Windows Overview, Windows Demonstration
DATA Barmenu Function Demo, ScrollMenu Function Demo
DATA Message Function Demo, Infield Function Demo, DatIn Demo
DATA Print Routines
DATA Random Pattern Generator,Random Scroll,Exit To Dos


barmenudata:
DATA Parameters
DATA The barmenu function  accepts two arrays
DATA as  parameters.  The first  contains the
DATA heading  names that  will  appear  above
DATA their  respective menu.  The second is a
DATA two dimensional  array  to  contain  the
DATA lists of items which  appear under their
DATA respective headings.,,,,,,,,,,,,,,

DATA Headings
DATA You may pass as many menu  headings
DATA as  you can  fit on  the  menu bar.
DATA you may  also pass  up to  22 items
DATA for each heading without shadows or
DATA 21  if you prefer shadows.  Barmenu
DATA returns  the  subscript  chosen and
DATA key  the  user  entered to  escape.,,,,,,,,,,,,,,

DATA Sizing
DATA The function automatically sizes
DATA everthing for you.  The  headers
DATA are spaced and the widths of the
DATA windows are set according to the
DATA widest item element.  The header
DATA bar filler character is variable
DATA to suit different styles.,,,,,,,,,,,,,,

DATA Auto-adjust
DATA If you like your menu choices to be  extremely descriptive -
DATA no problem!  The bar menu function will automatically adjust
DATA your sub-menu to fit asthetically under the menu label.   So
DATA use the whole screen if you wish!  Hit ESC or ENTER for menu.
DATA Line 5
DATA Line 6
DATA Line 7
DATA Line 8
DATA Line 9
DATA Line 10
DATA Line 11
DATA Line 12
DATA Line 13
DATA Line 14
DATA Line 15
DATA Line 16
DATA Line 17
DATA Line 18
DATA Line 19
DATA Line 20
DATA Line 21

scrolldata:
DATA The scrollmenu function allows the user to choose from a list
DATA of items which would not normally fit within the boundaries
DATA of a window.  The list may be as long as needed and the window
DATA may be as short as needed (minimum of one line).
DATA "                                                        MORE "
DATA "     Scrolling of one full window length is done with the PgUp"
DATA and PgDn keys.  the up and down cursor keys allow moving one
DATA line at a time.
DATA " "
DATA "     The following is a demonstration of choosing an item from"
DATA the scrollmenu list.            Press <ENTER> to continue

fielddata:
DATA 14,13,17, 14,36,10, 14,52,17
DATA 16,13,17, 16,36,10, 16,52,17

SUB bardemo
   DIM headers(1 TO 4) AS STRING
   DIM Items(1 TO 4, 1 TO 21) AS STRING
   DIM scr AS STRING, retrn  AS STRING

   RESTORE barmenudata
   FOR x = 1 TO 4
       READ headers(x)
       FOR y = 1 TO 21
       READ Items(x, y)
       NEXT y
   NEXT x

   RESCREEN background

   DEFWIN 0, 0, 15, 3, 0, 3, THIN, YES
   DEFBAR 0, 7, 205, NO

   baron = NO
   retrn = BARMENU(headers(), Items(), m, i)
   SELECT CASE retrn
     CASE ESC: retrn = "n escape keypress"
     CASE CR: retrn = " carriage return"
   END SELECT

   DIM Msg(1 TO 1) AS STRING
   Msg(1) = "You exited with a" + retrn
   Msg(1) = Msg(1) + " and chose menu" + STR$(m) + ", item" + STR$(i) + "."
   DEFWIN 15, 0, 15, 4, 14, 4, THIN, YES
   Msg(1) = MESSAGE(14, c, "Message Box", Msg(), "", 5, YES)

END SUB

SUB begin
    DIM win AS STRING, bar AS STRING, raise AS STRING
    DIM fg AS INTEGER, bg AS INTEGER
    DIM lin(1 TO 12) AS STRING
    DIM clr AS STRING, vid AS STRING

    'Create Opening Screen
    DEFWIN 0, 0, 7, 1, 7, 1, NONE, NO
    OPENWIN 1, 1, 25, 80, ""

    'Lightning!
    w$ = STRING$(15, 219)
    var = 56
    FOR x = 1 TO 25
       IF x MOD 7 = 0 THEN var = var + 10
       IF x > 21 THEN w$ = LEFT$(w$, LEN(w$) - 3)
       IF x = 25 THEN var = var + 1
       IF x < 25 THEN HILITE x + 1, var - x * 3 + 1, LEN(w$), 8
       PRINTS w$, x, var - x * 3, CM(14, 7)
    NEXT x

    'Print Bottom Bar Labels
    PRINTS SPACE$(80), 1, 1, ATTRIB(WHT + BRITE, MAG)
    PRINTS HEADLINE, 1, 40 - LEN(HEADLINE) / 2, 0


    'laser sound effect
     PLAY "mf"
     FOR x = 10000 TO 37 STEP -100
     SOUND x \ 2, .03
     SOUND x, .07
     NEXT x

    ' ***********************  FIRST WINDOW  ***************************
    lin(1) = "  V U D U   W I N D O W S   Version 3.01  By Binary Systems"
    lin(2) = "    User interface and display tools for Microsoft BASICs"
    lin(3) = " "
    lin(4) = "       Press Any Key For The Demonstration Program "

    DEFWIN 15, 4, 15, 4, 14, 4, PAIR, YES
    w$ = MESSAGE(r, c, "", lin(), "", 300, YES)


    ' **********************  SECOND MESSAGE  ***************************
    'message window describing VUDU
    lin(1) = "VUDU (Very Useful Display Utilities) features:"
    lin(2) = "      Built in mouse support and mouse procedures"
    lin(3) = "      Automatic sensing of the active video page"
    lin(4) = "      Automatic sensing of monochrome/color card"
    lin(5) = "      Optional auto-centering for all windows"
    lin(6) = "      Auto snow elimination on CGA systems"
    lin(7) = "      Easy customization"
    DEFWIN 15, 4, 15, 4, 14, 4, PAIR, YES
    a$ = MESSAGE(0, 0, "The VUDU Windows", lin(), "", 15, YES)


    ' Print VIDEO INFORMATION
    REDIM lin(1 TO 12) AS STRING
    SELECT CASE VIDCARD
     CASE MONO: lin(1) = "MonoChrome"
     CASE CGA:  lin(1) = "CGA"
     CASE EGA:  lin(1) = "EGA"
     CASE VGA:  lin(1) = "VGA"
    END SELECT
    lin(1) = lin(1) + " Video Card Detected"
    IF Vmouse THEN
       lin(2) = "Mouse is active"
    ELSE
       lin(2) = "Mouse not installed"
    END IF